#!/usr/bin/perl
# Author Damian 'Rush' Kaczmarek
# License: MIT
#
# Script for cleaning perl source files in a project/directory scale.
#
# Temporarily it is bound to the project "nimfomanka".
my $perltidy_args = "-l=120 -i=8 -et=8 -bar -sbl -pt=2 -sbt=2 -bt=2 -bbt=2 -nsfs -nolq -bbs -b";

BEGIN {
	if ($#ARGV == -1) {
		print "Usage: " . $0 . " <action> file1 file2 ... fileN\n";
		print "Usage: " . $0 . " <action>\n";
		print "       " . $0 . " clean       - cleans up the source files and saves results in .clean files\n";
		print "       " . $0 . " save        - replaces original source files with the cleaned ones\n";
		print "       " . $0 . " discard     - discards the cleaned sources\n";
		exit 0;
	}
}
use Perl::Tidy;
use File::stat;
use File::Copy;

sub mtime # Returns last file modification date.
{
	stat($_[0])->mtime;
}

sub rmfile # Tries to remove a file. Pass 1 as a second argument to omit the error detection.
{
	if ($_[1]) {
		unlink($_[0]);
	}
	else {
		unlink($_[0]) or die("Could not delete file '" . $_ . "'. Please check file permissions.");
	}
}

sub ask # Ask the user whether they want to continue.
{
	print $_[0] . "\n";
	print "Proceed? (Y/n): ";
	my $answer;
	read(STDIN, $answer, 1);
	if ($answer ne "Y") {
		print "Oh, see you next time then.\n";
		exit 1;
	}
}

sub get_filenames
{
	my @files;
	my $postfix = $_[0];
	if (not defined $postfix) {
		$postfix = "";
	}

	if ($#ARGV > -1) {    # User supplied the filelist
		foreach my $filename (@ARGV) {
			$filename .= $postfix;
			if (!(-e $filename)) {
				print "Warning: File '" . $filename . "' does not exist!\n";
			}
			else {
				push(@files, $filename);
			}
		}
		return @files;
	}

	opendir(DIR, ".");
	@files = readdir(DIR);
	closedir(DIR);

	if (!grep(/^nimfomanka.pl$/, @files) || !grep(/^Modules$/, @files)) {
		die("Current working directory is not a proper application directory.\n");
	}
	opendir(DIR, "Modules");
	@files = (@files, map {"Modules/" . $_} readdir(DIR));
	closedir(DIR);
	return grep(/\.(pl|pm)$postfix$/, @files);    # Filter out only perl scripts matching the postfix
}

my $arg = shift @ARGV;
if ($arg eq "clean") {
	my @files = get_filenames();
	if (!@files) {
		die("No files to process.\n");
	}
	ask("The following files will be cleaned: " . join(', ', @files));

	foreach $file (get_filenames()) {
		print "Cleaning file '" . $file . "' ...";
		perltidy(
			source      => $file,
			destination => $file . ".clean",
			argv        => $perltidy_args,
			stderr      => "/dev/null"
		);
		if (-e $file . ".ERR") {
			print " Error. Please see '" . $file . ".ERR' for details.\n";
			rmfile($file . ".clean");
		}
		else {
			print " OK\n";
		}
	}
}
elsif ($arg eq "save") {
	my %files;
	@files{get_filenames(".clean")} = ();    # Create a hash out of file list

	foreach my $cleanfile (keys(%files)) {   # Sanity check the file list
		$cleanfile =~ /(.*)\.clean/;
		my $dirtyfile = $1;
		if (!(-e $dirtyfile)) {          # Each .clean file must have its normal counterpart.
			print "Warning: File '" . $dirtyfile . "' does not exist! Changes can't be commited.\n";
			rmfile($cleanfile);
			delete($files{$cleanfile});    # Delete element from the hash
		}
		$files{$cleanfile} = $dirtyfile;
		if (mtime($cleanfile) < mtime($dirtyfile)) {
			print "Warning: File '"
			  . $dirtyfile
			  . "' has newer modification date than the cleaned up data. Omitting.\n";
			rmfile($cleanfile);
			delete($files{$cleanfile});    # Delete element from the hash
		}
	}
	if (!values(%files)) {
		die("No files to process.\n");
	}
	ask("The following files will be updated: " . join(', ', values(%files)));
	while (my ($cleanfile, $dirtyfile) = each(%files)) {
		print "Updating file " . $dirtyfile . " ...";
		move($cleanfile, $dirtyfile);
		print " OK\n";
	}
}
elsif ($arg eq "discard") {
	my @files = get_filenames();
	if (!@files) {
		die("No files to process.\n");
	}
	ask("All .clean and .ERR files will be deleted.");
	foreach $filename (get_filenames()) {
		rmfile($filename . ".clean", 1);
		rmfile($filename . ".ERR",   1);
	}
}
